'
'   XC Engine (project Minotaur)
'   Copyright (C) 2009 Stanislav Hordiyenko
'
'   This program is free software; you can redistribute it and/or modify
'   it under the terms of the GNU General Public License as published by
'   the Free Software Foundation; either version 3 of the License, or
'   (at your option) any later version.
'
'   This program is distributed in the hope that it will be useful,
'   but WITHOUT ANY WARRANTY; without even the implied warranty of
'   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'   GNU General Public License for more details.
'
'   You should have received a copy of the GNU General Public License
'   along with this program; if not, see http://www.gnu.org/licenses
'   or write to the Free Software Foundation,Inc., 51 Franklin Street,
'   Fifth Floor, Boston, MA 02110-1301 USA
'

Class TestScriptEngine
	Private objScriptControl
	Private strTestScript
	Private blnErrorExists
	Private objError

	Private Sub Class_Initialize()
		Set objScriptControl = CreateObject("MSScriptControl.ScriptControl")
		
		objScriptControl.Language = "VBScript"
		objScriptControl.Timeout = -1
		blnErrorExists = False
		
		Set objError = Nothing
	End Sub
	
	Private Sub Class_Terminate()
		Set objError = Nothing
		Set objScriptControl = Nothing
	End Sub
	
	Public Sub AddObject(ByVal strObjectName, ByVal objObject)
		objScriptControl.AddObject strObjectName, objObject, True
	End Sub
	
	Public Sub AddObjects(ByVal objObjectList)
		If TypeName(objObjectList) <> "Dictionary" Then
			Err.Raise 5000, "TestScriptEngine->AddObjects", "Error Description"
		End If
		
		For Each strObjectName In objObjectList.Keys
			Call AddObject(strObjectName, objObjectList(strObjectName))
		Next
	End Sub
	
	Public Sub AddTestScript(ByVal strParameterTestScript)
		strTestScript = strParameterTestScript
	End Sub
	
	Public Property Get ErrorExists
		ErrorExists = blnErrorExists
	End Property
	
	Public Property Get Error
		If Not ErrorExists Then
			Err.Raise 5000, "TestScriptEngine->Error", "There is no error occured"
		
			Exit Property
		End If
	
		Set Error = objError
	End Property
	
	Public Property Get ErrorDetails
		If Not ErrorExists Then
			Err.Raise 5000, "TestScriptEngine->ErrorDetails", "There is no error occured"
		
			Exit Property
		End If
	
		' Also return a cauple of test script lines, where the error occured. For this purpose, there is a necessity to store the initial test script without changes
		strErrorDetails = "[line {line}:column {column}] ({class}) {number} - {description}"
		strErrorDetails = Replace(strErrorDetails, "{line}", Error.Line)
		strErrorDetails = Replace(strErrorDetails, "{column}", Error.Column)
		strErrorDetails = Replace(strErrorDetails, "{class}", Error.Source)
		strErrorDetails = Replace(strErrorDetails, "{number}", Error.Number)
		strErrorDetails = Replace(strErrorDetails, "{description}", Error.Description)
	
		ErrorDetails = strErrorDetails
	End Property
	
	Public Sub Execute()
		If strTestScript = "" Then 
			Err.Raise 5000, "TestScriptEngine->Execute", "Error Description"
		End If
	
		On Error Resume Next
			objScriptControl.AddCode strTestScript
			
			If Err.Number <> 0 Then
				blnErrorExists = True
			
				Set objError = objScriptControl.Error
			End If
		On Error Goto 0
	End Sub
End Class